Este exercício prático demonstra como aplicar técnicas de análise de cluster para segmentar pacientes com base em indicadores de saúde. A identificação de subgrupos de pacientes pode ajudar no desenvolvimento de intervenções personalizadas, otimização de recursos e melhoria nos cuidados de saúde.
Uma clínica especializada em saúde metabólica deseja identificar padrões entre seus pacientes para desenvolver programas de tratamento mais personalizados. A clínica coletou dados de diversos indicadores de saúde e agora precisa de uma análise para identificar grupos naturais de pacientes com características similares.
# Pacotes para manipulação e visualização de dados
library(tidyverse) # Manipulação e visualização de dados
library(cluster) # Algoritmos de clustering
library(factoextra) # Visualização de clusters
library(NbClust) # Determinar número ótimo de clusters
library(fpc) # Estatísticas de validação de cluster
library(corrplot) # Visualização de matrizes de correlação
library(gridExtra) # Organização de múltiplos gráficos
library(psych) # Estatísticas descritivas
# Definir a semente aleatória para reprodutibilidade
set.seed(123)Para este exercício, utilizaremos um conjunto de dados simulados que representa perfis de saúde de pacientes.
# Número de pacientes
n <- 400
# Simular diferentes perfis de pacientes
# Perfil 1: Pacientes com maior risco cardiovascular
grupo1 <- data.frame(
idade = rnorm(n/4, mean = 62, sd = 8),
imc = rnorm(n/4, mean = 32, sd = 4), # Obesidade
pressao_sistolica = rnorm(n/4, mean = 148, sd = 15), # Hipertensão
glicose_jejum = rnorm(n/4, mean = 105, sd = 15), # Normal alto
hdl = rnorm(n/4, mean = 38, sd = 5), # Baixo
ldl = rnorm(n/4, mean = 155, sd = 20), # Alto
triglicerideos = rnorm(n/4, mean = 190, sd = 45), # Alto
a1c = rnorm(n/4, mean = 6.0, sd = 0.7), # Normal alto
proteina_c_reativa = rnorm(n/4, mean = 4.5, sd = 2.5), # Elevada (inflamação)
atividade_fisica = rnorm(n/4, mean = 2, sd = 1.5) # Baixa (horas/semana)
)
# Perfil 2: Pacientes com diabetes não controlado
grupo2 <- data.frame(
idade = rnorm(n/4, mean = 55, sd = 10),
imc = rnorm(n/4, mean = 31, sd = 3.5), # Obesidade
pressao_sistolica = rnorm(n/4, mean = 135, sd = 10), # Ligeiramente elevada
glicose_jejum = rnorm(n/4, mean = 180, sd = 30), # Muito alta
hdl = rnorm(n/4, mean = 42, sd = 6), # Ligeiramente baixo
ldl = rnorm(n/4, mean = 130, sd = 25), # Moderado
triglicerideos = rnorm(n/4, mean = 160, sd = 40), # Moderadamente alto
a1c = rnorm(n/4, mean = 8.5, sd = 1.2), # Elevado
proteina_c_reativa = rnorm(n/4, mean = 3.0, sd = 1.8), # Moderada
atividade_fisica = rnorm(n/4, mean = 3, sd = 2) # Moderada
)
# Perfil 3: Jovens com fatores de risco
grupo3 <- data.frame(
idade = rnorm(n/4, mean = 35, sd = 7),
imc = rnorm(n/4, mean = 27, sd = 3.5), # Sobrepeso
pressao_sistolica = rnorm(n/4, mean = 125, sd = 10), # Normal
glicose_jejum = rnorm(n/4, mean = 98, sd = 10), # Normal
hdl = rnorm(n/4, mean = 45, sd = 8), # Moderado
ldl = rnorm(n/4, mean = 125, sd = 20), # Limítrofe
triglicerideos = rnorm(n/4, mean = 150, sd = 35), # Limítrofe
a1c = rnorm(n/4, mean = 5.5, sd = 0.3), # Normal
proteina_c_reativa = rnorm(n/4, mean = 2.0, sd = 1.0), # Normal
atividade_fisica = rnorm(n/4, mean = 3.5, sd = 2.5) # Moderada
)
# Perfil 4: Pacientes saudáveis
grupo4 <- data.frame(
idade = rnorm(n/4, mean = 45, sd = 12),
imc = rnorm(n/4, mean = 23, sd = 2), # Saudável
pressao_sistolica = rnorm(n/4, mean = 115, sd = 8), # Ótima
glicose_jejum = rnorm(n/4, mean = 85, sd = 7), # Normal
hdl = rnorm(n/4, mean = 58, sd = 7), # Bom
ldl = rnorm(n/4, mean = 95, sd = 15), # Ótimo
triglicerideos = rnorm(n/4, mean = 95, sd = 25), # Normal
a1c = rnorm(n/4, mean = 5.2, sd = 0.2), # Normal
proteina_c_reativa = rnorm(n/4, mean = 0.8, sd = 0.5), # Baixa
atividade_fisica = rnorm(n/4, mean = 7, sd = 2) # Alta
)
# Combinar todos os grupos
pacientes <- rbind(grupo1, grupo2, grupo3, grupo4)
# Assegurar que os valores sejam realistas
pacientes <- pacientes %>%
mutate(
imc = pmax(16, pmin(45, imc)), # Limitar IMC entre 16 e 45
pressao_sistolica = pmax(90, pmin(220, pressao_sistolica)), # Limitar pressão
glicose_jejum = pmax(60, pmin(300, glicose_jejum)), # Limitar glicose
hdl = pmax(20, pmin(90, hdl)), # Limitar HDL
ldl = pmax(50, pmin(250, ldl)), # Limitar LDL
triglicerideos = pmax(40, pmin(400, triglicerideos)), # Limitar triglicerídeos
a1c = pmax(4.0, pmin(12.0, a1c)), # Limitar A1C
proteina_c_reativa = pmax(0.1, pmin(10.0, proteina_c_reativa)), # Limitar PCR
atividade_fisica = pmax(0, pmin(14, atividade_fisica)) # Limitar atividade física
)
# Adicionar um ID para cada paciente
pacientes$id_paciente <- 1:nrow(pacientes)
# Verificar a estrutura dos dados
glimpse(pacientes)## Rows: 400
## Columns: 11
## $ idade <dbl> 57.51619, 60.15858, 74.46967, 62.56407, 63.03430, 7…
## $ imc <dbl> 29.15837, 33.02753, 31.01323, 30.60983, 28.19353, 3…
## $ pressao_sistolica <dbl> 180.9822, 167.6862, 144.0228, 156.1479, 141.7849, 1…
## $ glicose_jejum <dbl> 94.27137, 93.70967, 90.92192, 89.21230, 98.44261, 1…
## $ hdl <dbl> 37.63222, 32.15674, 34.82626, 37.85579, 41.35348, 2…
## $ ldl <dbl> 142.9621, 135.1260, 175.5357, 170.0212, 124.8167, 1…
## $ triglicerideos <dbl> 238.33055, 188.76939, 188.50013, 121.77696, 225.567…
## $ a1c <dbl> 5.490247, 4.921690, 5.514834, 6.083195, 5.044703, 6…
## $ proteina_c_reativa <dbl> 5.3907084, 2.8549745, 6.6380055, 7.3823406, 5.19068…
## $ atividade_fisica <dbl> 0.4788287, 0.8130292, 2.4493905, 4.4585779, 3.62692…
## $ id_paciente <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, …
## idade imc pressao_sistolica glicose_jejum
## Min. : 9.984 Min. :18.22 Min. : 91.4 Min. : 65.12
## 1st Qu.:37.414 1st Qu.:24.02 1st Qu.:118.5 1st Qu.: 88.19
## Median :50.482 Median :27.94 Median :130.1 Median :101.43
## Mean :49.362 Mean :27.93 Mean :131.0 Mean :116.68
## 3rd Qu.:60.241 3rd Qu.:31.16 3rd Qu.:141.2 3rd Qu.:129.20
## Max. :83.322 Max. :44.96 Max. :182.4 Max. :281.71
## hdl ldl triglicerideos a1c
## Min. :24.70 Min. : 60.22 Min. : 40.0 Min. : 4.453
## 1st Qu.:38.98 1st Qu.:105.75 1st Qu.:108.2 1st Qu.: 5.243
## Median :44.53 Median :128.61 Median :142.9 Median : 5.695
## Mean :45.95 Mean :127.05 Mean :146.9 Mean : 6.314
## 3rd Qu.:52.20 3rd Qu.:147.59 3rd Qu.:186.4 3rd Qu.: 7.017
## Max. :72.54 Max. :203.60 Max. :300.6 Max. :11.593
## proteina_c_reativa atividade_fisica id_paciente
## Min. : 0.1000 Min. : 0.000 Min. : 1.0
## 1st Qu.: 0.9493 1st Qu.: 1.874 1st Qu.:100.8
## Median : 2.0497 Median : 3.533 Median :200.5
## Mean : 2.6979 Mean : 4.093 Mean :200.5
## 3rd Qu.: 4.0247 3rd Qu.: 6.047 3rd Qu.:300.2
## Max. :10.0000 Max. :12.790 Max. :400.0
## vars n mean sd median trimmed mad min max
## idade 1 400 49.36 14.56 50.48 49.42 17.04 9.98 83.32
## imc 2 400 27.93 4.77 27.94 27.74 5.37 18.22 44.96
## pressao_sistolica 3 400 131.01 16.67 130.13 129.99 16.56 91.40 182.40
## glicose_jejum 4 400 116.68 40.45 101.43 110.17 22.42 65.12 281.71
## hdl 5 400 45.95 9.87 44.53 45.40 8.99 24.70 72.54
## ldl 6 400 127.05 28.26 128.61 127.16 30.39 60.22 203.60
## triglicerideos 7 400 146.91 50.54 142.88 145.61 58.90 40.00 300.61
## a1c 8 400 6.31 1.51 5.69 6.07 0.86 4.45 11.59
## proteina_c_reativa 9 400 2.70 2.18 2.05 2.42 1.83 0.10 10.00
## atividade_fisica 10 400 4.09 2.88 3.53 3.91 3.05 0.00 12.79
## range skew kurtosis se
## idade 73.34 -0.08 -0.84 0.73
## imc 26.74 0.37 -0.19 0.24
## pressao_sistolica 91.00 0.54 0.18 0.83
## glicose_jejum 216.59 1.34 0.91 2.02
## hdl 47.84 0.51 -0.27 0.49
## ldl 143.38 -0.03 -0.63 1.41
## triglicerideos 260.61 0.25 -0.48 2.53
## a1c 7.14 1.31 0.81 0.08
## proteina_c_reativa 9.90 1.10 0.77 0.11
## atividade_fisica 12.79 0.54 -0.46 0.14
# Matriz de correlação
matriz_cor <- cor(pacientes[, 1:10])
corrplot(matriz_cor, method = "circle", type = "upper",
tl.col = "black", tl.cex = 0.7, tl.srt = 45,
title = "Matriz de Correlação dos Indicadores de Saúde")# Histogramas das variáveis
pacientes %>%
select(-id_paciente) %>%
gather() %>%
ggplot(aes(value)) +
geom_histogram(bins = 30, fill = "steelblue", color = "black", alpha = 0.7) +
facet_wrap(~ key, scales = "free") +
theme_minimal() +
labs(title = "Distribuição dos Indicadores de Saúde",
x = "Valor", y = "Frequência")## [1] 0
# Selecionar apenas as variáveis relevantes para clustering
dados_cluster <- pacientes[, 1:10] # Todas as variáveis exceto o ID
# Padronização dos dados (Z-score)
dados_padronizados <- scale(dados_cluster)
summary(dados_padronizados)## idade imc pressao_sistolica glicose_jejum
## Min. :-2.70424 Min. :-2.037231 Min. :-2.37574 Min. :-1.2746
## 1st Qu.:-0.82051 1st Qu.:-0.819886 1st Qu.:-0.75102 1st Qu.:-0.7043
## Median : 0.07692 Median : 0.001705 Median :-0.05293 Median :-0.3771
## Mean : 0.00000 Mean : 0.000000 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.74714 3rd Qu.: 0.676452 3rd Qu.: 0.61376 3rd Qu.: 0.3094
## Max. : 2.33223 Max. : 3.573117 Max. : 3.08168 Max. : 4.0797
## hdl ldl triglicerideos a1c
## Min. :-2.1530 Min. :-2.36482 Min. :-2.11525 Min. :-1.2309
## 1st Qu.:-0.7061 1st Qu.:-0.75369 1st Qu.:-0.76493 1st Qu.:-0.7081
## Median :-0.1439 Median : 0.05543 Median :-0.07961 Median :-0.4097
## Mean : 0.0000 Mean : 0.00000 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.6329 3rd Qu.: 0.72702 3rd Qu.: 0.78068 3rd Qu.: 0.4646
## Max. : 2.6922 Max. : 2.70926 Max. : 3.04118 Max. : 3.4902
## proteina_c_reativa atividade_fisica
## Min. :-1.1935 Min. :-1.4229
## 1st Qu.:-0.8033 1st Qu.:-0.7715
## Median :-0.2978 Median :-0.1949
## Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.6095 3rd Qu.: 0.6792
## Max. : 3.3546 Max. : 3.0228
## idade imc pressao_sistolica glicose_jejum
## 2.106648e-15 5.911938e-16 -8.323342e-15 -2.461920e-16
## hdl ldl triglicerideos a1c
## 1.105782e-15 -2.590705e-15 -7.792378e-16 1.112721e-15
## proteina_c_reativa atividade_fisica
## -1.214306e-15 1.018075e-15
## idade imc pressao_sistolica glicose_jejum
## 1 1 1 1
## hdl ldl triglicerideos a1c
## 1 1 1 1
## proteina_c_reativa atividade_fisica
## 1 1
# Avaliação da tendência de clustering
# Nota: A função hopkins() pode não estar disponível em algumas instalações
# Vamos verificar se o pacote clustertend está carregado e, se necessário, usar uma abordagem alternativa
if(!requireNamespace("clustertend", quietly = TRUE)) {
cat("O pacote 'clustertend' não está instalado. Usando método alternativo.\n")
# Método alternativo: comparar a distribuição de distâncias original com uma aleatória
set.seed(123)
dist_original <- as.vector(dist(dados_padronizados))
# Criar um conjunto de dados aleatório com a mesma dimensionalidade
dados_aleatorios <- matrix(runif(prod(dim(dados_padronizados))),
nrow = nrow(dados_padronizados))
dist_aleatorio <- as.vector(dist(dados_aleatorios))
# Calcular a diferença nas médias das distâncias
media_orig <- mean(dist_original)
media_aleat <- mean(dist_aleatorio)
tendencia_valor <- media_aleat / (media_orig + media_aleat)
cat("Estatística de tendência clustering alternativa:", round(tendencia_valor, 3), "\n")
} else {
# Usar a função hopkins do pacote clustertend se disponível
library(clustertend)
set.seed(123)
tendencia <- clustertend::hopkins(dados_padronizados, n = nrow(dados_padronizados) * 0.1)
tendencia_valor <- as.numeric(tendencia)
cat("Estatística de Hopkins:", round(tendencia_valor, 3), "\n")
}## Estatística de Hopkins: 0.312
cat("Interpretação: Valores acima de 0.5 sugerem tendência de clustering.\n",
"Quanto mais próximo de 1, maior a tendência.\n")## Interpretação: Valores acima de 0.5 sugerem tendência de clustering.
## Quanto mais próximo de 1, maior a tendência.
# Método do cotovelo (Elbow Method)
fviz_nbclust(dados_padronizados, kmeans, method = "wss", k.max = 10) +
labs(title = "Método do Cotovelo (Elbow Method)",
subtitle = "Soma dos quadrados dentro dos clusters vs. Número de clusters")# Método da silhueta
fviz_nbclust(dados_padronizados, kmeans, method = "silhouette", k.max = 10) +
labs(title = "Método da Silhueta",
subtitle = "Largura média da silhueta vs. Número de clusters")# Gap statistic
# Nota: Pode ser computacionalmente intensivo
# Usar uma amostra para tornar o cálculo mais rápido
set.seed(123)
amostra_indices <- sample(1:nrow(dados_padronizados), 100)
gap_stat <- clusGap(dados_padronizados[amostra_indices, ],
FUN = kmeans,
nstart = 25,
K.max = 10,
B = 50)
fviz_gap_stat(gap_stat) +
labs(title = "Gap Statistic",
subtitle = "Gap statistic vs. Número de clusters")# Este código pode ser computacionalmente intensivo
# Descomente e execute se desejar uma avaliação mais completa
# set.seed(123)
# res.nbclust <- NbClust(dados_padronizados,
# distance = "euclidean",
# min.nc = 2,
# max.nc = 10,
# method = "kmeans")
#
# # Resumir os resultados
# freq_k <- table(res.nbclust$Best.nc[1,])
#
# # Visualizar o número de clusters sugerido por múltiplos índices
# barplot(freq_k,
# xlab = "Número de Clusters",
# ylab = "Número de Critérios",
# main = "Número Ótimo de Clusters")Pergunta: Com base nos métodos usados, qual você acredita ser o número ideal de clusters para este conjunto de dados de pacientes? Justifique sua resposta.
# Aplicar K-means com o número selecionado de clusters (suponha k=4)
set.seed(123)
k_selecionado <- 4 # Ajuste este valor conforme sua análise acima
kmeans_resultado <- kmeans(dados_padronizados, centers = k_selecionado, nstart = 25)
# Adicionar os clusters ao dataframe original
pacientes$cluster_kmeans <- kmeans_resultado$cluster
# Visualizar os clusters
fviz_cluster(kmeans_resultado, data = dados_padronizados,
palette = "jco",
ellipse.type = "convex",
repel = TRUE,
ggtheme = theme_minimal()) +
labs(title = "Clusters de Pacientes (K-means)",
subtitle = paste("K =", k_selecionado))# Avaliação da qualidade do clustering - Silhueta
silhueta_kmeans <- silhouette(kmeans_resultado$cluster, dist(dados_padronizados))
fviz_silhouette(silhueta_kmeans) +
labs(title = "Análise de Silhueta para K-means")## cluster size ave.sil.width
## 1 1 97 0.26
## 2 2 100 0.25
## 3 3 98 0.22
## 4 4 105 0.34
# Média da silhueta por cluster
media_silhueta <- mean(silhueta_kmeans[, "sil_width"])
cat("Coeficiente de silhueta médio:", round(media_silhueta, 3), "\n")## Coeficiente de silhueta médio: 0.27
# Cálculo da matriz de distância
dist_matriz <- dist(dados_padronizados, method = "euclidean")
# Aplicar clustering hierárquico usando o método de Ward
hc_ward <- hclust(dist_matriz, method = "ward.D2")
# Visualizar o dendrograma
plot(hc_ward, main = "Dendrograma - Método de Ward",
xlab = "", sub = "", cex = 0.6)
rect.hclust(hc_ward, k = k_selecionado, border = 2:5)# Cortar o dendrograma para obter clusters
clusters_hc <- cutree(hc_ward, k = k_selecionado)
# Adicionar os clusters ao dataframe original
pacientes$cluster_hc <- clusters_hc
# Visualizar os clusters
fviz_cluster(list(data = dados_padronizados, cluster = clusters_hc),
palette = "jco",
ellipse.type = "convex",
repel = TRUE,
ggtheme = theme_minimal()) +
labs(title = "Clusters de Pacientes (Hierárquico)",
subtitle = paste("K =", k_selecionado))# Avaliação da qualidade - Silhueta
silhueta_hc <- silhouette(clusters_hc, dist_matriz)
fviz_silhouette(silhueta_hc) +
labs(title = "Análise de Silhueta para Clustering Hierárquico")## cluster size ave.sil.width
## 1 1 99 0.25
## 2 2 101 0.22
## 3 3 105 0.22
## 4 4 95 0.36
# Média da silhueta
media_silhueta_hc <- mean(silhueta_hc[, "sil_width"])
cat("Coeficiente de silhueta médio (Hierárquico):", round(media_silhueta_hc, 3), "\n")## Coeficiente de silhueta médio (Hierárquico): 0.261
# Tabela de contingência entre os dois métodos
tabela_comp <- table(K_means = pacientes$cluster_kmeans,
Hierarquico = pacientes$cluster_hc)
print(tabela_comp)## Hierarquico
## K_means 1 2 3 4
## 1 0 2 95 0
## 2 98 2 0 0
## 3 1 97 0 0
## 4 0 0 10 95
# Índice Rand Ajustado (ARI) - necessita do pacote mclust
if (!requireNamespace("mclust", quietly = TRUE)) {
cat("Pacote 'mclust' não disponível. Não é possível calcular o Índice Rand Ajustado.\n")
# Alternativa simples: calcular a proporção de concordância
n_total <- nrow(pacientes)
concordancia <- sum(diag(prop.table(tabela_comp)))
cat("Proporção de concordância entre métodos:", round(concordancia, 3), "\n")
cat("Interpretação: Valores próximos de 1 indicam alta concordância entre os métodos.\n")
} else {
# Usar a função adjustedRandIndex do pacote mclust
ari <- mclust::adjustedRandIndex(pacientes$cluster_kmeans, pacientes$cluster_hc)
cat("Índice Rand Ajustado:", round(ari, 3), "\n")
cat("Interpretação: Valores próximos de 1 indicam alta concordância entre os métodos.\n")
}## Índice Rand Ajustado: 0.904
## Interpretação: Valores próximos de 1 indicam alta concordância entre os métodos.
# Para fins deste exercício, continuaremos com os resultados do K-means
pacientes$cluster_final <- pacientes$cluster_kmeansPergunta: Qual dos dois métodos (K-means ou Hierárquico) você acredita que produziu clusters mais coerentes para este conjunto de dados? Justifique com base nas visualizações e métricas de avaliação.
# Estatísticas por cluster
perfil_clusters <- pacientes %>%
select(-id_paciente, -cluster_kmeans, -cluster_hc) %>%
group_by(cluster_final) %>%
summarise(across(everything(), list(média = mean, dp = sd)),
n_pacientes = n(),
prop_pacientes = n() / nrow(pacientes) * 100)
# Exibir o perfil de cada cluster
print(perfil_clusters)## # A tibble: 4 × 23
## cluster_final idade_média idade_dp imc_média imc_dp pressao_sistolica_média
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 34.4 6.59 26.6 3.10 125.
## 2 2 62.7 7.30 31.6 3.87 150.
## 3 3 56.4 10.4 31.0 3.50 135.
## 4 4 44.0 12.8 22.9 1.87 115.
## # ℹ 17 more variables: pressao_sistolica_dp <dbl>, glicose_jejum_média <dbl>,
## # glicose_jejum_dp <dbl>, hdl_média <dbl>, hdl_dp <dbl>, ldl_média <dbl>,
## # ldl_dp <dbl>, triglicerideos_média <dbl>, triglicerideos_dp <dbl>,
## # a1c_média <dbl>, a1c_dp <dbl>, proteina_c_reativa_média <dbl>,
## # proteina_c_reativa_dp <dbl>, atividade_fisica_média <dbl>,
## # atividade_fisica_dp <dbl>, n_pacientes <int>, prop_pacientes <dbl>
# Visualização do perfil dos clusters - valores médios
perfil_viz <- pacientes %>%
select(-id_paciente, -cluster_kmeans, -cluster_hc) %>%
group_by(cluster_final) %>%
summarise(across(everything(), mean)) %>%
pivot_longer(cols = -cluster_final,
names_to = "variavel",
values_to = "valor")
# Padronizar os valores para o gráfico de radar
perfil_viz_norm <- perfil_viz %>%
group_by(variavel) %>%
mutate(valor_padronizado = (valor - min(valor)) / (max(valor) - min(valor)))
# Gráfico de radar para comparar os perfis dos clusters
ggplot(perfil_viz_norm,
aes(x = variavel, y = valor_padronizado,
group = factor(cluster_final),
color = factor(cluster_final))) +
geom_line() +
geom_point() +
coord_polar() +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom") +
labs(title = "Perfil dos Clusters de Pacientes",
subtitle = "Valores médios padronizados",
color = "Cluster") +
scale_color_brewer(palette = "Set1")# Função para criar boxplot para uma variável específica
criar_boxplot <- function(var_nome) {
ggplot(pacientes, aes(x = factor(cluster_final), y = .data[[var_nome]],
fill = factor(cluster_final))) +
geom_boxplot() +
theme_minimal() +
labs(title = paste("Distribuição de", var_nome, "por Cluster"),
x = "Cluster", y = var_nome) +
scale_fill_brewer(palette = "Set1") +
theme(legend.position = "none")
}
# Criar boxplots para cada variável
variaveis <- names(pacientes)[1:10] # Primeiras 10 variáveis (excluindo IDs e clusters)
boxplots <- lapply(variaveis, criar_boxplot)
# Organizar os boxplots em uma grade (2x5)
do.call(gridExtra::grid.arrange, c(boxplots, ncol = 2))Com base nas análises acima, vamos interpretar cada um dos clusters no contexto clínico:
| Cluster | Caracteristicas | Intervencoes_Sugeridas |
|---|---|---|
| 1 | Preencher com base nos resultados | Preencher com base nos resultados |
| 2 | Preencher com base nos resultados | Preencher com base nos resultados |
| 3 | Preencher com base nos resultados | Preencher com base nos resultados |
| 4 | Preencher com base nos resultados | Preencher com base nos resultados |
Exercício: Complete a tabela acima com: 1. As principais características de cada cluster, baseado nas análises realizadas. 2. Intervenções clínicas personalizadas que você recomendaria para cada grupo.
# Função para realizar validação cruzada do clustering
validacao_cruzada_kmeans <- function(dados, k, n_folds = 5) {
set.seed(123)
n <- nrow(dados)
fold_indices <- sample(rep(1:n_folds, length.out = n))
resultados <- data.frame(fold = 1:n_folds, silhueta = NA)
for (i in 1:n_folds) {
# Dividir dados em treino e teste
dados_treino <- dados[fold_indices != i, ]
dados_teste <- dados[fold_indices == i, ]
# Treinar modelo em dados de treino
modelo <- kmeans(dados_treino, centers = k, nstart = 25)
# Atribuir clusters para dados de teste
distancias <- matrix(NA, nrow = nrow(dados_teste), ncol = k)
for (j in 1:nrow(dados_teste)) {
for (l in 1:k) {
distancias[j, l] <- sqrt(sum((dados_teste[j, ] - modelo$centers[l, ])^2))
}
}
clusters_teste <- apply(distancias, 1, which.min)
# Calcular silhueta nos dados de teste
dist_teste <- dist(dados_teste)
sil <- silhouette(clusters_teste, dist_teste)
resultados$silhueta[i] <- mean(sil[, "sil_width"])
}
return(resultados)
}
# Aplicar validação cruzada para k=4
vc_resultados <- validacao_cruzada_kmeans(dados_padronizados, k = k_selecionado)
print(vc_resultados)
# Calcular média e desvio padrão da silhueta entre os folds
cat("Média da silhueta (validação cruzada):", mean(vc_resultados$silhueta), "\n")
cat("Desvio padrão da silhueta:", sd(vc_resultados$silhueta), "\n")Como o algoritmo K-means depende da inicialização aleatória, é importante verificar a estabilidade dos resultados.
# Função para executar K-means múltiplas vezes
executar_kmeans_multiplas <- function(dados, k, n_execucoes = 30) {
resultados <- data.frame(execucao = 1:n_execucoes,
wcss = NA, # Within-cluster sum of squares
silhueta = NA)
clusters_matriz <- matrix(NA, nrow = nrow(dados), ncol = n_execucoes)
for (i in 1:n_execucoes) {
set.seed(i * 100) # Sementes diferentes para cada execução
km <- kmeans(dados, centers = k, nstart = 25)
resultados$wcss[i] <- km$tot.withinss
sil <- silhouette(km$cluster, dist(dados))
resultados$silhueta[i] <- mean(sil[, "sil_width"])
clusters_matriz[, i] <- km$cluster
}
# Calcular concordância entre pares de execuções
if (!requireNamespace("mclust", quietly = TRUE)) {
# Alternativa se mclust não estiver disponível
ari_matriz <- matrix(NA, nrow = n_execucoes, ncol = n_execucoes)
for (i in 1:n_execucoes) {
for (j in 1:n_execucoes) {
if (i != j) {
# Calcular proporção de concordância como alternativa ao ARI
tabela <- table(clusters_matriz[, i], clusters_matriz[, j])
ari_matriz[i, j] <- sum(diag(prop.table(tabela)))
} else {
ari_matriz[i, j] <- 1 # Diagonal (mesma execução)
}
}
}
metrica_nome <- "Proporção de Concordância"
} else {
# Usar adjustedRandIndex se mclust estiver disponível
ari_matriz <- matrix(NA, nrow = n_execucoes, ncol = n_execucoes)
for (i in 1:n_execucoes) {
for (j in 1:n_execucoes) {
if (i != j) {
ari_matriz[i, j] <- mclust::adjustedRandIndex(
clusters_matriz[, i], clusters_matriz[, j])
} else {
ari_matriz[i, j] <- 1 # Diagonal (mesma execução)
}
}
}
metrica_nome <- "Índice Rand Ajustado"
}
return(list(
resultados = resultados,
ari_matriz = ari_matriz,
ari_medio = mean(ari_matriz[lower.tri(ari_matriz)]),
metrica_nome = metrica_nome
))
}
# Executar análise de sensibilidade
sensibilidade <- executar_kmeans_multiplas(dados_padronizados, k = k_selecionado, n_execucoes = 10)
# Visualizar os resultados
ggplot(sensibilidade$resultados, aes(x = execucao)) +
geom_line(aes(y = wcss, color = "WCSS")) +
geom_line(aes(y = silhueta * max(sensibilidade$resultados$wcss) * 2, color = "Silhueta")) +
scale_y_continuous(
name = "WCSS",
sec.axis = sec_axis(~. / (max(sensibilidade$resultados$wcss) * 2), name = "Silhueta")
) +
theme_minimal() +
labs(title = "Análise de Sensibilidade para K-means",
subtitle = paste("Média do", sensibilidade$metrica_nome, "entre execuções:",
round(sensibilidade$ari_medio, 3)),
x = "Execução", color = "Métrica") +
scale_color_manual(values = c("WCSS" = "red", "Silhueta" = "blue"))# Visualizar matriz de concordância
corrplot(sensibilidade$ari_matriz,
method = "circle",
type = "upper",
title = paste(sensibilidade$metrica_nome, "entre Múltiplas Execuções"),
mar = c(0, 0, 1, 0))Pergunta: Com base na análise de sensibilidade, quão estáveis são os resultados do K-means para este conjunto de dados? Isso afeta sua confiança nas interpretações clínicas?
Neste exercício, você aplicou técnicas de análise de cluster para segmentar pacientes com base em indicadores de saúde. Os resultados podem ajudar a clínica a desenvolver programas de tratamento personalizados e otimizar recursos.
Exercícios Finais:
Escreva um resumo de uma página sobre os principais achados desta análise, incluindo:
Como esta abordagem de segmentação de pacientes poderia ser implementada na prática clínica? Quais desafios você antecipa e como eles poderiam ser superados?
Que variáveis adicionais poderiam ser incorporadas para melhorar a segmentação dos pacientes? Como essas variáveis poderiam impactar os resultados?